home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / roman_jg < prev    next >
Internet Message Format  |  1995-03-31  |  9KB
  1. From: James Gentles <jdg@hpqtdla.sqf.hp.com>
  2. Subject:  v04i023:  roman_jg - Roman Numerals v1.0, Part01/01
  3. Newsgroups: comp.sources.hp48
  4. Followup-To: comp.sys.hp48
  5. Approved: spell@seq.uncwil.edu
  6.  
  7. Checksum:  393391880 (verify with brik -cv)
  8. Submitted-by: James Gentles <jdg@hpqtdla.sqf.hp.com>
  9. Posting-number: Volume 4, Issue 23
  10. Archive-name: roman_jg/part01
  11.  
  12. ------------------------------------------------------------------------
  13.        I have no professional connection with Hewlett-Packard's 
  14.      calculator operations other than as a user of their products.
  15. ------------------------------------------------------------------------
  16.  Opinions expressed are my own, and are not intended to be an official
  17.            statement by Hewlett-Packard Company/Limited
  18. ------------------------------------------------------------------------
  19.   "To strive, to seek, to find, and not to yield."  Ulysses, Tennyson.
  20. ------------------------------------------------------------------------
  21. James Gentles     Hewlett Packard,  Amateur: GM4WZP
  22. Queensferry Telecoms Division QTD,    Email: jdg@hpsqf.sqf.hp.com 
  23. Station Road,   South Queensferry,   HPDESK: James Gentles / HP1400 
  24. West Lothian, Scotland,  EH30 9XR.    Phone: +44 31 331 7663, FAX: ~7488
  25. ------------------------------------------------------------------------
  26.  
  27. BEGIN_DOC roman.doc
  28. ROMAN NUMERAL CONVERSION ROUTINES FOR THE HP48                          15Mar92
  29.  
  30. The following two routines translate between integers and roman numerals.
  31. The Roman system uses 7 letters to represent different weightings:
  32.      M 1000
  33.      D 500
  34.      C 100
  35.      L 50
  36.      X 10
  37.      V 5
  38.      I 1
  39. These are assembled additively into a string, largest numbers being left
  40. justified:
  41. e.g. "MCL" is 1150
  42. In addition any character may be preceeded by one of the following:
  43.      C 100
  44.      X 10
  45.      I 1
  46. and this is subtracted from the character. So 9 is "IX" and NOT "VIIII"
  47. However "IM" is not allowed for 999. The preceeding character must be
  48. the next least significant of the ones listed above, e.g. "CMXCIX" for 999.
  49. Only one preceeding character is allowed at a time, 8 is NOT "IIX" it should 
  50. be represented by "VIII".
  51.  
  52. Finally a whole expression can be multiplied by 1000 if a bar covers it.
  53. This aspect is not reproduced in the following programs.
  54.  
  55.  
  56. ->RN: Takes a number from the stack and returns a string containing the
  57.       roman numeral. The result is "tagged" with the original number from
  58.       the stack. If the stack is empty then a message indicating the
  59.       correct syntax for the routine is returned. If the number has a
  60.       fractional part then the fraction is ignored. If the number is greater
  61.       than 10000 then only the part of the number <10000 is processed, the
  62.       resulting string is preceeded with a "+" to indicate this. This
  63.       prevents the creation of very long roman numerals with dozens of
  64.       preceeding "M"'s, that take ages to process.
  65.  
  66. RN->: Takes a string from the stack and returns the equivalent integer.
  67.       The result is "tagged" with the original string from the stack. 
  68.       If the stack is empty then a message indicating the correct syntax 
  69.       for the routine is returned. If the string contains characters other
  70.       than "MDCLXVI" then the program fails. The routine will translate all
  71.       legal roman numerals, it will also  translate some non legal ones:
  72.       e.g. "VX" (5) "MIM" (1999), however it will not translate "IIV" 
  73.       correctly.
  74. END_DOC
  75. HP48 ASCII CODE for \->RN.....................................................
  76. BEGIN_RPL torn.rpl
  77. %%HP: T(3)A(D)F(.);
  78. \<< DEPTH
  79.   IF THEN IP "MDCLXVI" "CCXXII " { 1000 500  @ Create four lists that
  80.      100 50 10 5 1 } { 100 100 10 10 1 1 0 } @ define the translation
  81.      \-> r rs w ws
  82.     \<< DUP DUP 10000 > 
  83.       IF THEN 10000 MOD "+"                  @ If greater than 10000 then
  84.       ELSE ""                                @ truncate input and add "+"
  85.       END 
  86.       1 r SIZE FOR i                         @ For each character in the
  87.         r i i SUB rs i i SUB w i GET ws i GET@ translation get the weighting
  88.         \-> r1 r2 w1 w2                      @ from the list
  89.         \<<
  90.           WHILE OVER w1 \>=
  91.           REPEAT SWAP w1 - SWAP r1 +         @ subtract weighting as
  92.           END                                @ many times as possible.
  93.           IF OVER w2 + w1 \>=                @ Check if one more can be
  94.           THEN SWAP w1 - w2 + SWAP r2 + r1 + @ subtracted with preceeding
  95.           END                                @ character.
  96.         \>>
  97.       NEXT
  98.     \>> SWAP DROP SWAP \->TAG                @ Tag output with input integer
  99.   ELSE
  100. "INT \-> Roman Numeral $"                    @ Print this string as help
  101. DOERR
  102.   END
  103. \>>
  104. END_RPL
  105.  
  106. HP48 ASCII CODE for RN\->.....................................................
  107. BEGIN_RPL fromrn.rpl
  108. %%HP: T(3)A(D)F(.);
  109. \<< DEPTH IF
  110.   THEN EVAL DUP SIZE "IVXLCDM" { 1 5 10      @ Create two lists for 
  111.   50 100 500 1000 } \-> s l r w              @ the translation
  112.     \<< { } 
  113.       1 l FOR i                              @ for each character in the input
  114.       s i i SUB r SWAP POS w SWAP GET +      @ build a list of the weights
  115.       NEXT 0 + l \-> v l
  116.       \<< 0 1 l FOR i                        @ For the list of weights
  117.         v i GET DUP v i 1 + GET <            @ subtract if followed by a
  118.           IF THEN - ELSE + END               @ larger number else add
  119.         NEXT s \->TAG                        @ Tag output with input string
  120.       \>>
  121.     \>>
  122.   ELSE
  123. "Roman Numeral $ \-> INT"                    @ Print this string as help
  124. DOERR
  125.   END
  126. \>>
  127. END_RPL
  128.  
  129. [Note:  I created a diectory and put the two programs in there.
  130.  So the asc'ed & uuencoded versions should have the correct file
  131.  names in the 48.  -cgs ]
  132.  
  133. BEGIN_ASC roman.asc
  134. %%HP: T(3)A(D)F(.);
  135. "69A20FF78A200000003025E4D830D9D20E163244CF13CE22AFE22D9D20EB3A17
  136. 8BF18B9C1C2A2031000946585C43444D447A209C2A2D13A23392010000000000
  137. 0001033920100000000000005033920200000000000001033920200000000000
  138. 0050339203000000000000010B21301C432D6E201037D6E2010C6D6E201027D6
  139. E201077E163247A20B21309C2A2D6E2010C60A132D6E201096D6E201037D6E20
  140. 1096D6E201096C58C1D6E201027DBBF14BAC1D6E201077DBBF16C7D176BA1C42
  141. 324B2A276BA1D6E2010C61C432D6E201067D6E2010C6E16324B2A29C2A2D6E20
  142. 10C60A132D6E201096D6E201067D6E2010966C7D178BF1D6E201067D6E201096
  143. 9C2A276BA16C7D1EBBE13CE22AFE2290DA15BF2276BA15DF22C4232D6E201037
  144. EB522EF532EF532B21305BF22D9D20C2A20F200025F6D616E602E457D6562716
  145. C6024202D80294E445933A1B21305DF2293632B21309920030D825E430D9D20E
  146. 163244CF13CE22AFE22D9D20D6BB1C2A2031000D44434C4856594C2A20310003
  147. 434858594940247A203392030000000000000103392020000000000000503392
  148. 02000000000000010339201000000000000050339201000000000000010D13A2
  149. 9C2A2B213047A203392020000000000000103392020000000000000103392010
  150. 000000000000103392010000000000000109C2A29C2A24B2A2B21301C432D6E2
  151. 01027D6E20202737D6E201077D6E20207737E163278BF178BF13392040000000
  152. 00000010D5CE13CE22AFE22D9D20339204000000000000010D4EB1C2A2070000
  153. B2B21305BF22C2A20500005DF229C2A2D6E2010278B9C10A132D6E201096D6E2
  154. 01027D6E201096D6E201096C58C1D6E20202737D6E201096D6E201096C58C1D6
  155. E201077D6E2010966C7D1D6E20207737D6E2010966C7D11C432D6E20202713D6
  156. E20202723D6E20207713D6E20207723E16323303292CF1D6E20207713B9DE1D5
  157. 032D9D20DBBF1D6E2020771390DA1DBBF1D6E2020271376BA1B2130496323CE2
  158. 292CF1D6E2020772376BA1D6E20207713B9DE1AFE22D9D20DBBF1D6E20207713
  159. 90DA1D6E2020772376BA1DBBF1D6E2020272376BA1D6E2020271376BA1B21305
  160. DF22EF532C4232EF532DBBF18DBF1DBBF1EB522B21305BF22D9D20C2A20F2000
  161. 94E44502D80225F6D616E602E457D6562716C60242933A1B21305DF2293632B2
  162. 13001CF"
  163. END_ASC
  164.  
  165.  
  166. BYTES: #FC10h 875
  167.  
  168. BEGIN_UU roman.uue
  169. begin 644 roman
  170. M2%!(4#0X+466*O!_J`(````#4DZ-`YTMX&$C1/PQ["+Z+M+9`KZC<;@?N,G!
  171. MH@(3`)!DA<4T1-1$IP+)HM(Q*C,I$````````!`PDP(!````````!3,I(```
  172. M`````!`PDP("````````!3,I,````````!"P$@/!--+F`@%S;2X0P-;F`@%R
  173. M;2X0<.=A(W0JL!(#R:+2Y@(!;*`QTN8"`6EM+A`PU^8"`6EM+A"0QH4<;2X0
  174. M(->['[3*T>8"`7>]^V%\'6>KP20CM*)RMAIM+A#`%DPC;2X08-?F`@%L'C9"
  175. M*RK)HM+F`@%LH#'2Y@(!:6TN$Y@(!:<;7<;@?;2X08-?F`@%IR:)RMAK&
  176. MU^&['L,NHN\B":U1^R)GJU'](DPRTN8"`7.^)>)?(_XULA(#M2_2V0(L*O`"
  177. M`%)O;6%N($YU;65R86P@)""-($E.5#FCL1(#U2^28R,K,9`I``.-4DX#G2W@
  178. M82-$_#'L(OHNTMD";;O!H@(3`-!$-,2$997$H@(3`#`TA(65E`1"IP(S*3``
  179. M```````0,),"`@````````4S*2`````````0,),"`0````````4S*1``````
  180. M```0T#$JR:*R$@-T*C"3`@(````````!,RD@````````$#"3`@$````````!
  181. M,RD0````````$)`L*LFB0BLJ*S$03"-M+A`@U^8"`G)S;2X0<-?F`@)W<QXV
  182. M<K@?A_LQDP($`````````5WL,>PB^B[2V0(S*4`````````0T.0;+"IP```K
  183. M*S%0^R(L*E```-4ODBPJ;2X0((>;'*`QTN8"`6EM+A`@U^8"`6EM+A"0QH4<
  184. M;2X@(#?7Y@(!:6TN$)#&A1QM+A!PU^8"`6G&U]'F`@)W<VTN$)!F?!W!--+F
  185. M`@)R,6TN("`GT^8"`G<Q;2X@<"?C82,S,)+"'VTN('`7L]D>73#2V0*]^]'F
  186. M`@)W,0FMT;L?;2X@(!=SMAHK,4!I(\,NDL(?;2X@<"=SMAIM+B!P%[/9'OHN
  187. MTMD"O?O1Y@("=S$)K='F`@)W,F>KT;L?;2X@("=SMAIM+B`@%W.V&BLQ4/TB
  188. M_C7")"/^-=*[']C[T;L?OB6R$@.U+]+9`BPJ\`(`24Y4((T@4F]M86X@3G5M
  189. 397)A;"`D.:.Q$@/5+Y)C(RLQ`"LQ
  190. `
  191. end
  192. END_UU
  193.